home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_Tix.idb / usr / freeware / lib / tix4.1 / DirTree.tcl.z / DirTree.tcl
Encoding:
Text File  |  1999-01-26  |  9.3 KB  |  401 lines
  1. # DirTree.tcl --
  2. #
  3. #    Implements directory tree for Unix file systems
  4. #
  5. #       What the indicators mean:
  6. #
  7. #    (+): There are some subdirectories in this directory which are not
  8. #         currently visible.
  9. #    (-): This directory has some subdirectories and they are all visible
  10. #
  11. #      none: The dir has no subdirectori(es).
  12. #
  13. # Copyright (c) 1996, Expert Interface Technologies
  14. #
  15. # See the file "license.terms" for information on usage and redistribution
  16. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  17. #
  18.  
  19. tixWidgetClass tixDirTree {
  20.     -classname TixDirTree
  21.     -superclass tixVTree
  22.     -method {
  23.     activate chdir refresh
  24.     }
  25.     -flag {
  26.     -browsecmd -command -directory -disablecallback -showhidden -value
  27.     }
  28.     -configspec {
  29.     {-browsecmd browseCmd BrowseCmd ""}
  30.     {-command command Command ""}
  31.     {-disablecallback disableCallback DisableCallback 0 tixVerifyBoolean}
  32.     {-showhidden showHidden ShowHidden 0 tixVerifyBoolean}
  33.     {-value value Value ""}
  34.     }
  35.     -alias {
  36.     {-directory -value}
  37.     }
  38.     -default {
  39.     {.scrollbar            auto}
  40.     {*Scrollbar.background          #d9d9d9}
  41.     {*Scrollbar.relief              sunken}
  42.     {*Scrollbar.takeFocus           0}
  43.     {*Scrollbar.troughColor         #c3c3c3}
  44.     {*Scrollbar.width               15}
  45.     {*borderWidth                   1}
  46.     {*hlist.indicator               1}
  47.     {*hlist.background              #c3c3c3}
  48.     {*hlist.drawBranch              1}
  49.     {*hlist.height                  10}
  50.     {*hlist.highlightBackground      #d9d9d9}
  51.     {*hlist.indent                  20}
  52.     {*hlist.itemType                imagetext}
  53.     {*hlist.padX                    3}
  54.     {*hlist.padY                    0}
  55.     {*hlist.relief                  sunken}
  56.     {*hlist.takeFocus               1}
  57.     {*hlist.wideSelection           0}
  58.     {*hlist.width                   20}
  59.     }
  60. }
  61.  
  62. proc tixDirTree:InitWidgetRec {w} {
  63.     upvar #0 $w data
  64.  
  65.     tixChainMethod $w InitWidgetRec
  66.  
  67.     if {$data(-value) == ""} {
  68.     global env
  69.     if {[info exists env(PWD)]} {
  70.         set data(-value) $env(PWD)
  71.     } else {
  72.         set data(-value) [pwd]
  73.     }
  74.     }
  75.  
  76.     tixDirTree:SetDir $w [tixFileIntName $data(-value)]
  77. }
  78.  
  79. proc tixDirTree:ConstructWidget {w} {
  80.     upvar #0 $w data
  81.  
  82.     tixChainMethod $w ConstructWidget
  83.     tixDoWhenMapped $w "tixDirTree:StartUp $w"
  84.  
  85.     $data(w:hlist) config \
  86.     -separator [tixDirSep] \
  87.     -selectmode "single" -drawbranch 1
  88.  
  89.     # We must creat an extra copy of these images to avoid flashes on
  90.     # the screen when user changes directory
  91.     #
  92.     set data(images) [image create compound -window $data(w:hlist)]
  93.     $data(images) add image -image [tix getimage act_fold]
  94.     $data(images) add image -image [tix getimage folder]
  95.     $data(images) add image -image [tix getimage openfold]
  96. }
  97.  
  98. proc tixDirTree:SetBindings {w} {
  99.     upvar #0 $w data
  100.  
  101.     tixChainMethod $w SetBindings
  102.  
  103. # %% do I still need this?
  104. #   bind $data(w:hlist) <3> "tixDirTree:DeleteSib $w %x %y"
  105. }
  106.  
  107. # This procedure is supposed to "trim" the directory tree view to
  108. # just the current directory and its ancestors.
  109. #
  110. #proc tixDirTree:DeleteSib {w x y} {
  111. #    upvar #0 $w data
  112. #
  113. #    set ent [$data(w:hlist) nearest $y]
  114. #
  115. #    if {$ent != ""} {
  116. #    $data(w:hlist) anchor set $ent
  117. #
  118. #    for {set e $ent} {$e != "/"} {set e [$data(w:hlist) info parent $e]} {
  119. #        $data(w:hlist) delete siblings $e
  120. #    }
  121. #    tixDirTree:Browse $w $ent
  122. #    }
  123. #}
  124.  
  125. # %% This functions needs to be optimized
  126. #
  127. #
  128. proc tixDirTree:HasSubDir {w dir} {
  129.     upvar #0 $w data
  130.  
  131.     if {[tixListDir $dir 1 0 0 $data(-showhidden)] != ""} {
  132.     return 1
  133.     } else {
  134.     return 0
  135.     }
  136. }
  137.  
  138.  
  139. # Add one dir into the parent directory, sorted alphabetically
  140. #
  141. proc tixDirTree:AddToList {w dir parent name image} {
  142.     upvar #0 $w data
  143.  
  144.     set added 0
  145.     foreach sib [$data(w:hlist) info children $parent] {
  146.     if {[string compare $dir $sib] < 0} {
  147.         $data(w:hlist) add $dir -before $sib -text $name -image $image
  148.         set added 1
  149.         break
  150.     }
  151.     }
  152.     if !$added {
  153.     $data(w:hlist) add $dir -text $name -image $image
  154.     }
  155.  
  156.     if [tixDirTree:HasSubDir $w $dir] {
  157.     tixVTree:SetMode $w $dir open
  158.     }
  159. }
  160.  
  161. # Add $dir and all ancestors of $dir into the HList widget
  162. #
  163. #
  164. proc tixDirTree:AddAncestors {w dir} {
  165.     upvar #0 $w data
  166.     uplevel #0 set TRANSPARENT_GIF_COLOR [$data(w:hlist) cget -bg]
  167.  
  168.     set path ""
  169.     set parent ""
  170.     foreach name [tixFileSplit $dir] {
  171.     set path [tixSubFolder $path $name]
  172.     if {![$data(w:hlist) info exists $path]} {
  173.         tixDirTree:AddToList $w $path $parent [tixFileDisplayName $path] \
  174.         [tix getimage openfold]
  175.     }
  176.     set parent $path
  177.     }
  178. }
  179.  
  180. # Add all the sub directories of $dir into the HList widget
  181. #
  182. #
  183. proc tixDirTree:ListDirs {w dir} {
  184.     upvar #0 $w data
  185.     uplevel #0 set TRANSPARENT_GIF_COLOR [$data(w:hlist) cget -bg]
  186.  
  187.     tixBusy $w on $data(w:hlist)
  188.  
  189.     foreach name [tixListDir $dir 1 0 0 $data(-showhidden)] {
  190.     set subdir [tixSubFolder $dir $name]
  191.     if {![$data(w:hlist) info exists $subdir]} {
  192.         tixDirTree:AddToList $w $subdir $dir [tixFileDisplayName $subdir] \
  193.         [tix getimage folder]
  194.     }
  195.     }
  196.  
  197.     tixWidgetDoWhenIdle tixBusy $w off $data(w:hlist)
  198. }
  199.  
  200. proc tixDirTree:LoadDir {w dir {mode toggle}} {
  201.     if {![winfo exists $w]} {
  202.     return
  203.     }
  204.  
  205.     upvar #0 $w data
  206.     uplevel #0 set TRANSPARENT_GIF_COLOR [$data(w:hlist) cget -bg]
  207.  
  208.     # Add the directory and set it to the active directory
  209.     #
  210.     if ![$data(w:hlist) info exists $dir] {
  211.     tixDirTree:AddAncestors $w $dir
  212.     }
  213.     $data(w:hlist) entryconfig $dir -image [tix getimage act_fold]
  214.  
  215.     if {$mode == "toggle"} {
  216.     if {[$data(w:hlist) info children $dir] == ""} {
  217.         set mode expand
  218.     } else {
  219.         set mode flatten
  220.     }
  221.     }
  222.  
  223.     if {$mode == "expand"} {
  224.     tixDirTree:ListDirs $w $dir
  225.     if {[$data(w:hlist) info children $dir] == ""} {
  226.         tixVTree:SetMode $w $dir none
  227.     } else {
  228.         tixVTree:SetMode $w $dir close
  229.     }
  230.     } else {
  231.     $data(w:hlist) delete offsprings $dir
  232.     tixVTree:SetMode $w $dir open
  233.     }
  234. }
  235.  
  236. proc tixDirTree:ToggleDir {w value mode} {
  237.     upvar #0 $w data
  238.  
  239.     tixDirTree:LoadDir $w $value $mode
  240.     tixDirTree:CallCommand $w
  241. }
  242.  
  243. proc tixDirTree:CallCommand {w} {
  244.     upvar #0 $w data
  245.  
  246.     if {$data(-command) != "" && !$data(-disablecallback)} {
  247.     set bind(specs) {%V}
  248.     set bind(%V)    $data(-value)
  249.  
  250.     tixEvalCmdBinding $w $data(-command) bind $data(-value)
  251.     }
  252. }
  253.  
  254. proc tixDirTree:CallBrowseCmd {w ent} {
  255.     upvar #0 $w data
  256.  
  257.     if {$data(-browsecmd) != "" && !$data(-disablecallback)} {
  258.     set bind(specs) {%V}
  259.     set bind(%V)    $data(-value)
  260.  
  261.     tixEvalCmdBinding $w $data(-browsecmd) bind [list $data(-value)]
  262.     }
  263. }
  264.  
  265. proc tixDirTree:StartUp {w} {
  266.     if {![winfo exists $w]} {
  267.     return
  268.     }
  269.  
  270.     upvar #0 $w data
  271.  
  272.     tixDirTree:LoadDir $w $data(i-directory)
  273. }
  274.  
  275. proc tixDirTree:ChangeDir {w value {forced 0}} {
  276.     upvar #0 $w data
  277.  
  278.     if {!$forced && $data(i-directory) == $value} {
  279.     return
  280.     }
  281.     uplevel #0 set TRANSPARENT_GIF_COLOR [$data(w:hlist) cget -bg]
  282.  
  283.     if {!$forced && [$data(w:hlist) info exists $value]} {
  284.     # Set the old directory to "non active"
  285.     #
  286.     if [$data(w:hlist) info exists $data(i-directory)] {
  287.         $data(w:hlist) entryconfig $data(i-directory) \
  288.         -image [tix getimage folder]
  289.     }
  290.  
  291.     $data(w:hlist) entryconfig $value  \
  292.         -image [tix getimage act_fold]
  293.  
  294.     } else {
  295.     if {$forced} {
  296.         if {[$data(w:hlist) info children $value] == ""} {
  297.         set mode flatten
  298.         } else {
  299.         set mode expand
  300.         }
  301.     } else {
  302.         set mode toggle
  303.     }
  304.     tixDirTree:LoadDir $w $value $mode
  305.     tixDirTree:CallCommand $w
  306.     }
  307.     tixDirTree:SetDir $w $value
  308. }
  309.  
  310.  
  311. proc tixDirTree:SetDir {w intName} {
  312.     upvar #0 $w data
  313.  
  314.     set data(i-directory) $intName
  315.     set data(-value)  [tixNativeName $intName]
  316. }
  317.  
  318. #----------------------------------------------------------------------
  319. #
  320. # Virtual Methods
  321. #
  322. #----------------------------------------------------------------------
  323. proc tixDirTree:OpenCmd {w ent} {
  324.     tixDirTree:ToggleDir $w $ent expand
  325.     tixDirTree:ChangeDir $w $ent
  326.     tixDirTree:CallBrowseCmd $w $ent
  327. }
  328.  
  329. proc tixDirTree:CloseCmd {w ent} {
  330.     tixDirTree:ToggleDir $w $ent flatten
  331.     tixDirTree:ChangeDir $w $ent
  332.     tixDirTree:CallBrowseCmd $w $ent
  333. }
  334.  
  335. proc tixDirTree:Command {w B} {
  336.     upvar #0 $w data
  337.     upvar $B bind
  338.  
  339.     set ent [tixEvent flag V]
  340.     tixChainMethod $w Command $B
  341.  
  342.     if {$data(-command) != ""} {
  343.     tixEvalCmdBinding $w $data(-command) bind $ent
  344.     }
  345. }
  346.  
  347. # This is a virtual method
  348. #
  349. proc tixDirTree:BrowseCmd {w B} {
  350.     upvar #0 $w data
  351.     upvar $B bind
  352.     
  353.     set ent [tixEvent flag V]
  354.  
  355. #    if {[$data(w:hlist) indicator exist $ent] && 
  356. #    [$data(w:hlist) info children $ent] == ""} {
  357. #    
  358. #    tixVTree:Activate $w $ent open
  359. #   }
  360.  
  361.     if {[string index $ent 0] != "/"} {
  362.         # This is a hack because %V may have been modified by
  363.     # callbrowsecmd ....
  364.         set ent [tixFileIntName $ent]
  365.     } 
  366.     tixDirTree:ChangeDir $w $ent
  367.     tixDirTree:CallBrowseCmd $w $ent
  368. }
  369.  
  370. #----------------------------------------------------------------------
  371. #
  372. # Public Methods
  373. #
  374. #----------------------------------------------------------------------
  375. proc tixDirTree:chdir {w value} {
  376.     tixDirTree:ChangeDir $w [tixFileIntName $value]
  377. }
  378.  
  379. proc tixDirTree:refresh {w {dir ""}} {
  380.     upvar #0 $w data
  381.  
  382.     if {$dir == ""} {
  383.     set dir $data(-value)
  384.     }
  385.  
  386.     tixDirTree:ChangeDir $w [tixFileIntName $dir] 1
  387.  
  388.  
  389.     # Delete any stale directories that no longer exist
  390.     #
  391.     foreach sub [$data(w:hlist) info children [tixFileIntName $dir]] {
  392.     if {![file exists [tixNativeName $sub]]} {
  393.         $data(w:hlist) delete entry $sub
  394.     }
  395.     }
  396. }
  397.  
  398. proc tixDirTree:config-directory {w value} {
  399.     tixDirTree:ChangeDir $w [tixFileIntName $value]
  400. }
  401.